COMMENT ⊗   VALID 00005 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	TITLE OCULT   -   A HIDDEN LINE ELIMINATOR   -   AUGUST 1972.
 00005 00003	ZDEPTH(F,V)
 00007 00004	RINGIN(E,R,N) - RING IN E JUST LEFT OF R AT Nth WORD.
 00009 00005	SUBR(POTEN.)
 00010 ENDMK
⊗;
TITLE OCULT   -   A HIDDEN LINE ELIMINATOR   -   AUGUST 1972.
COMMENT /

/
;GEOMETRIC 2D LOCII ROUTINES.

;QEV(E,V).
SUBR(QEV)
BEGIN QEV
	ACCUMULATORS{E,V}
	LAC V,ARG1
	LAC E,ARG2
	LAC 1,CC(E)
	LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
	LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
	RET2
BEND

;QFEV(F,E,V).
SUBR(QFEV)
BEGIN QFEV
	ACCUMULATORS{E,V}
	LAC V,ARG1
	LAC E,ARG2
	LAC 1,CC(E)
	LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
	LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
	PFACE 0,E↔CAME 0,ARG3↔MOVNS 1
	RET3
BEND

;CROSSING(X,Y,E1,E2).
SUBR(CROSSING)
BEGIN CROSSING
	ACCUMULATORS{TT,XPTR,YPTR,E1,E2}
	LAC E2,ARG1
	LAC E1,ARG2
	LAC YPTR,ARG3
	LAC XPTR,ARG4
	LAC AA(E1)↔FMPR BB(E2)
	LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT
	LAC BB(E1)↔FMPR CC(E2)
	LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC(XPTR)
	LAC CC(E1)↔FMPR AA(E2)
	LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC(YPTR)
	RET4
BEND
;ZDEPTH(F,V)
SUBR(ZDEPTH)
BEGIN ZDEPTH
	ACCUMULATORS{F,V}
	LAC V,ARG1
	LAC F,ARG2
	LAC 1,KK(F)
	LAC AA(F)↔FMPR XPP(V)↔FSBR 1,0
	LAC BB(F)↔FMPR YPP(V)↔FSBR 1,0
	FDVR 1,CC(F)
	RET2
BEND

;ZDALT(F,X,Y)
SUBR(ZDALT)
BEGIN ZDALT
	ACCUMULATORS{F}
	LAC F,ARG3
	LAC 1,KK(F)
	LAC AA(F)↔FMPR ARG2↔FSBR 1,0
	LAC BB(F)↔FMPR ARG1↔FSBR 1,0
	FDVR 1,CC(F)
	RET3
BEND

;UFACE(E,V)
SUBR(UFACE)
BEGIN UFACE
	ACCUMULATORS{E,V}
	LAC E,ARG2
	NVT V,E↔CAMN V,ARG1↔GO[NUF 1,E↔RET2]
	PVT V,E↔CAMN V,ARG1↔GO[PUF 1,E↔RET2]
	FATAL(UFACE)
	LIT
BEND

;UFACE.(Q,E,V)
SUBR(UFACE.)
BEGIN UFACE.
	ACCUMULATORS{Q,E,V}
	CDR E,ARG2
	CDR Q,ARG3
	NVT V,E↔CAMN V,ARG1↔GO[NUF. Q,E↔RET3]
	PVT V,E↔CAMN V,ARG1↔GO[PUF. Q,E↔RET3]
	FATAL(UFACE.)
	LIT
BEND
;RINGIN(E,R,N) - RING IN E JUST LEFT OF R AT Nth WORD.
SUBR RINGIN
BEGIN RINGIN
	ACCUMULATORS{Q,E,R}
	CDR E,ARG3
	CDR R,ARG2
	LAC ARG1
	DAP .+1↔CDR Q,(E)↔JUMPE Q,L
	CAME Q,E↔RET3; E AIN'T EMPTY.
L:	DAP .+1↔CAR Q,(R)
	DAP .+1↔DAP E,(Q)
	DAP .+1↔DIP E,(R)
	DAP .+1↔DIP Q,(E)
	DAP .+1↔DAP R,(E)
	RET3
BEND

;RINGO(E,N) - RING OUT E AT Nth WORD - LEAVE E LEGALLY EMPTY.
SUBR RINGO
BEGIN RINGO
	ACCUMULATORS{Q,E,R}
	CDR ARG1↔CDR E,ARG2
	DAP .+1↔CAR Q,(E)↔JUMPE Q,L
	DAP .+1↔CDR R,(E)
	DAP .+1↔DAP R,(Q)
	DAP .+1↔DIP Q,(R)
L:	SLAP E,E
	DAP .+1↔DAC E,(E)
	RET2
BEND

;EMPTY(E,N) - RETURNS TRUE WHEN RING IS EMPTY.
SUBR(EMPTY)
BEGIN EMPTY
	CDR ARG1
	CDR 1,ARG2
	DAP .+1↔CDR (1)
	SKIPN↔RET2
	CAME 1↔SETZ 1,↔RET2
BEND
SUBR(POTEN.)
	LAC 1,ARG1↔MARKZ 1,VISIBLE↔MARK 1,POTENT↔RET1
SUBR(HIDE.)
	LAC 1,ARG1↔MARKZ 1,POTENT∨VISIBLE↔RET1
SUBR(VISIB.)
	LAC 1,ARG1↔MARK 1,VISIBLE↔MARKZ 1,POTENT↔RET1
SUBR(FOLD.)
	LAC 1,ARG1↔MARK  1,FOLDED ↔RET1
SUBR(TJUT.)
	LAC 1,ARG1↔MARK  1,1B3↔RET1
SUBR(TJOT.)
	LAC 1,ARG1↔MARK  1,1B4↔RET1
SUBR(TJUT)
	LAC 1,ARG1↔CAR 1,(1)↔ANDI 1,(1B3)↔RET1
SUBR(TJOT)
	LAC 1,ARG1↔CAR 1,(1)↔ANDI 1,(1B4)↔RET1
SUBR(TJ)
	LAC 1,ARG1↔CAR 1,(1)↔ANDI 1,(3B4)↔RET1

END